-- {-# LANGUAGE RankNTypes #-}

module CPS where

-- 1. Any type 普通类型的例子

newtype CPS r a = CPS {
    runCPS :: (a -> r) -> r
}

-- toCPS :: a -> CPS a a
toCPS :: a -> CPS r a
toCPS a = CPS (\c -> c a)

fromCPS :: CPS a a -> a
fromCPS (CPS c) = c id

-- 2. Tuple 积类型的例子

newtype TupleCPS r = TupleCPS {
    runTupleCPS :: (Int -> Bool -> r) -> r
}

-- toTupleCPS :: (Int, Bool) -> TupleCPS (Int, Bool)
toTupleCPS :: (Int, Bool) -> TupleCPS r
toTupleCPS (i, b) = TupleCPS (\k -> k i b)

fromTupleCPS :: TupleCPS (Int, Bool) -> (Int, Bool)
fromTupleCPS (TupleCPS c) = c (,) 


-- 3. Maybe a 和类型的例子

isNothing :: Maybe a -> Bool
isNothing Nothing = True
isNothing _ = False

isJust :: Maybe a -> Bool
isJust = not. isNothing

newtype MaybeCPS r a = MaybeCPS {
    runMaybeCPS :: (a -> r) -> r -> r
}

-- toMaybeCPS :: Maybe a -> MaybeCPS (Maybe a) a
toMaybeCPS :: Maybe a -> MaybeCPS r a
toMaybeCPS (Just x) = MaybeCPS (\ks kf -> ks x)
toMaybeCPS Nothing = MaybeCPS (\ks kf -> kf)

fromMaybeCPS :: MaybeCPS (Maybe a) a -> Maybe a
fromMaybeCPS (MaybeCPS c) = c Just Nothing


-- 4. Either a b 和类型的例子

newtype EitherCPS r a b = EitherCPS {
    runEitherCPS :: (a -> r) -> (b -> r) -> r
}

-- toEitherCPS :: Either a b -> EitherCPS (Either a b) a b
toEitherCPS :: Either a b -> EitherCPS r a b
toEitherCPS (Left x) = EitherCPS (\kl kr -> kl x)
toEitherCPS (Right y) = EitherCPS (\kl kr -> kr y)

fromEitherCPS :: EitherCPS (Either a b) a b -> Either a b
fromEitherCPS (EitherCPS e) = e Left Right